unit GBuilder; 

{
  PasCalc
  Version 1.2 2011-05-26

  Copyright (C) 2011 KEEPER <yar.keeper@gmail.com>

  This file is part of the PasCalc Calculator

  This library is free software; you can redistribute it and/or
  modify it under the terms of the GNU Lesser General Public
  License as published by the Free Software Foundation; either
  version 2.1 of the License, or (at your option) any later version.

  See the file LICENSE.TXT, included in this distribution,
  for details about the copyright.

  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
}

{$mode Delphi}{$H+}

interface

uses Windows, UsedTypes, Analyser, Graphics, Classes, NumerousMethods,
      MatrixOperations;

type

  PCanvas = TCanvas;

  { BuildObj }

  TIntMatrix = array of array of integer;

  BuildObj = class(TObject)
  private
    fLinesColor: TColor;
    fLinesWidth: integer;
    fOwner: PCanvas;
    fCursorPos: UsedTypes.TPoint;
    fExists: boolean;
    fOneSize: integer;
    fPath: ANSIString;
    procedure SetColor(const AValue: TColor);
    procedure SetCursorPos(const AValue: UsedTypes.TPoint);
    procedure SetLinesWidth(const AValue: integer);
    procedure SetOneSize(const AValue: integer);
    procedure SetOwner(const AValue: PCanvas);
  public
    property LinesColor: TColor read fLinesColor write SetColor;
    property Owner: PCanvas read fOwner write SetOwner;
    property CursorPos: UsedTypes.TPoint read fCursorPos write SetCursorPos;
    property LinesWidth: integer read fLinesWidth write SetLinesWidth;
    property IsExists: boolean read fExists;
    property OneSize: integer read fOneSize write SetOneSize;
    procedure CleanOwner;
    procedure Draw; virtual; abstract;
    procedure Delete; virtual; abstract;
    procedure Redraw;
    constructor Create(OwnerComp: PCanvas; const CurPos: UsedTypes.TPoint);
    procedure SaveToFile(const FileName: KOLString);
    procedure SaveToPng(const FileName: KOLString);
    procedure SaveToJpg(const FileName: KOLString);
    procedure RestoreGraph(const FileName: KOLString);
  end;

  { TCoordGrid }

  TCoordGrid = class(BuildObj)
  private
    fStyle: TGridStyle;
    procedure SetStyle(const AValue: TGridStyle);
    procedure DrawCells;
    procedure DrawCages;
    procedure DrawArrows;
  public
    property Style: TGridStyle read fStyle write SetStyle;
    procedure Draw; override;
    procedure Delete; override;
  end;

  { TCrosshair }

  TCrosshair = class(BuildObj)
  public
    procedure Draw; override;
    procedure Delete; override;
  end;

  { TGraph }

  TGraph = class(BuildObj)
  private
    Func: KOLString;
    IsRad: Boolean;
    fWorkMatrix: TIntMatrix;
  public
    procedure Draw; override;
    procedure Delete; override;
  end;

  { TTableGraph }

  TTableGraph = class(TGraph)
  private
    fSourcePoints: TFunction;
    procedure SetSourcePoints(const AValue: TFunction);
  public
    procedure Draw; override;
    property SourceTable: TFunction read fSourcePoints write SetSourcePoints;
  end;

  { TFigure }

  TFigure = class(BuildObj)
  private
    fGraphColor: TColor;
    fSourcePoints: TFunction;
    procedure SetGraphColor(const AValue: TColor);
    procedure SetSourcePoints(const AValue: TFunction);
  public
    Func: KOLString;
    IsRad: Boolean;
    Grid: TCoordGrid;
    ManyInOne: boolean;
    Graphs: TList;
    GridStyle: TGridStyle;
    constructor Create(OwnerComp: PCanvas; const CurPos: UsedTypes.TPoint);
    destructor Destroy; override;
    procedure Draw; override;
    procedure TableDraw;
    procedure Redraw;
    procedure Delete; override;
    property GraphColor: TColor read fGraphColor write SetGraphColor;
    property SourceTable: TFunction read fSourcePoints write SetSourcePoints;
  end;


implementation

{ BuildObj }

procedure BuildObj.SetColor(const AValue: TColor);
begin
  if fLinesColor = AValue then exit;
  fLinesColor := AValue;
end;

procedure BuildObj.SetCursorPos(const AValue: UsedTypes.TPoint);
begin
  fCursorPos := AValue;
end;

procedure BuildObj.SetLinesWidth(const AValue: integer);
begin
  if fLinesWidth = AValue then exit;
  fLinesWidth := AValue;
end;

procedure BuildObj.SetOneSize(const AValue: integer);
begin
  fOneSize := AValue;
end;

procedure BuildObj.SetOwner(const AValue: PCanvas);
begin
  fOwner := AValue;
end;

procedure BuildObj.CleanOwner;
begin
  Owner.Brush.Color := clWhite;
  Owner.FillRect(Owner.ClipRect);
end;

procedure BuildObj.Redraw;
begin
  Delete;
  Self.Draw;
end;

constructor BuildObj.Create(OwnerComp: PCanvas; const CurPos: UsedTypes.TPoint);
begin
  fOwner := OwnerComp;
  fLinesColor := clBlack;
  fCursorPos := CurPos;
  fExists := false;
  inherited Create;
end;

procedure BuildObj.SaveToFile(const FileName: KOLString);
var
  Bmp: TBitmap;
begin
  Bmp := TBitmap.Create;
  Bmp.Width := Owner.Width;
  Bmp.Height := Owner.Height;
  Bmp.Canvas.FillRect(Bmp.Canvas.ClipRect);
  Bmp.Canvas.CopyRect(Bmp.Canvas.ClipRect, fOwner, fOwner.ClipRect);
  Bmp.SaveToFile(FileName);
  Bmp.Free;
  fPath := FileName;
end;

procedure BuildObj.SaveToPng(const FileName: KOLString);
var
  Bmp: TBitmap;
  Png: TPortableNetworkGraphic;
begin
  Bmp := TBitmap.Create;
  Bmp.LoadFromFile(fPath);
  Png := TPortableNetworkGraphic.Create;
  Png.Assign(Bmp);
  Png.SaveToFile(FileName);
  Png.Free;
  Bmp.Free;
end;

procedure BuildObj.SaveToJpg(const FileName: KOLString);
var
  Bmp: TBitmap;
  Jpg: TJPEGImage;
begin
  Bmp := TBitmap.Create;
  Bmp.LoadFromFile(fPath);
  Jpg := TJPEGImage.Create;
  Jpg.Assign(Bmp);
  Jpg.CompressionQuality := 100;
  Jpg.SaveToFile(FileName);
  Jpg.Free;
  Bmp.Free;
end;

procedure BuildObj.RestoreGraph(const FileName: KOLString);
var
  Bmp: TBitmap;
begin
  Bmp := TBitMap.Create;
  Bmp.LoadFromFile(FileName);
  fOwner.CopyRect(fOwner.ClipRect, Bmp.canvas, Bmp.Canvas.ClipRect);
  Bmp.Free;
end;



{ TCoordGrid }

procedure TCoordGrid.SetStyle(const AValue: TGridStyle);
begin
  fStyle := AValue;
end;

procedure TCoordGrid.DrawCells;
var
  i: integer;
begin
  fOwner.Pen.Width := fLinesWidth;
  i := fCursorPos.x;
  while (i >= 0) do
  begin
    fOwner.MoveTo(i, 0);
    fOwner.LineTo(i, fOwner.ClipRect.Bottom);
    i := i - fOneSize;
  end;
  i := fCursorPos.x;
  while (i <= fOwner.ClipRect.Right) do
  begin
    fOwner.MoveTo(i, 0);
    fOwner.LineTo(i, fOwner.ClipRect.Bottom);
    i := i + fOneSize;
  end;
  i := fCursorPos.y;
  while (i >= 0) do
  begin
    fOwner.MoveTo(0, i);
    fOwner.LineTo(fOwner.ClipRect.Right, i);
    i := i - fOneSize;
  end;
  i := fCursorPos.y;
  while (i <= fOwner.ClipRect.Bottom) do
  begin
    fOwner.MoveTo(0, i);
    fOwner.LineTo(fOwner.ClipRect.Right, i);
    i := i + fOneSize;
  end;
end;

procedure TCoordGrid.DrawCages;
var
  i: integer;
  CageSize: integer;
begin
  cagesize := fOneSize div 3;
  fOwner.Pen.Width := fLinesWidth;
  i := fCursorPos.x;
  while (i >= 0) do
  begin
    fOwner.MoveTo(i, fCursorPos.y-CageSize);
    fOwner.LineTo(i, fCursorPos.y+CageSize);
    i := i - fOneSize;
  end;
  i := fCursorPos.x;
  while (i <= fOwner.ClipRect.Right) do
  begin
    fOwner.MoveTo(i, fCursorPos.y-CageSize);
    fOwner.LineTo(i, fCursorPos.y+CageSize);
    i := i + fOneSize;
  end;
  i := fCursorPos.y;
  while (i >= 0) do
  begin
    fOwner.MoveTo(fCursorPos.x - CageSize, i);
    fOwner.LineTo(fCursorPos.x + CageSize, i);
    i := i - fOneSize;
  end;
  i := fCursorPos.y;
  while (i <= fOwner.ClipRect.Bottom) do
  begin
    fOwner.MoveTo(fCursorPos.x - CageSize, i);
    fOwner.LineTo(fCursorPos.x + CageSize, i);
    i := i + fOneSize;
  end;
end;

procedure TCoordGrid.DrawArrows;
var
  XAxeCrd, YAxeCrd: TPoint;
  cgSize: integer;
begin
  XAxeCrd.x := fOwner.ClipRect.Right;
  XAxeCrd.y := fCursorPos.y;
  YAxeCrd.x := fCursorPos.x;
  YAxeCrd.y := fOwner.ClipRect.Top;
  cgSize := fOneSize div 3;
  fOwner.Pen.Width := fLinesWidth + 2;
  fOwner.MoveTo(XAxeCrd.x, XAxeCrd.y);
  fOwner.LineTo(XAxeCrd.x - cgSize, XAxeCrd.y-cgSize);
  fOwner.MoveTo(XAxeCrd.x, XAxeCrd.y);
  fOwner.LineTo(XAxeCrd.x - cgSize, XAxeCrd.y + cgSize);
  fOwner.MoveTo(YAxeCrd.x, YAxeCrd.y);
  fOwner.LineTo(YAxeCrd.x - cgSize, YAxeCrd.y + cgSize);
  fOwner.MoveTo(YAxeCrd.x, YAxeCrd.y);
  fOwner.LineTo(YAxeCrd.x + cgSize, YAxeCrd.y + cgSize);
  fOwner.Pen.Width := 1;
end;

procedure TCoordGrid.Draw;
begin
  fOwner.Pen.Width := fLinesWidth + 2;
  fOwner.Pen.Color := fLinesColor;
  fOwner.MoveTo(0, fCursorPos.y);
  fOwner.LineTo(fOwner.ClipRect.Right, fCursorPos.y);
  fOwner.MoveTo(fCursorPos.x, 0);
  fOwner.LineTo(fCursorPos.x, fOwner.ClipRect.Bottom);
  fOwner.Pen.Width := 1;
  if fStyle = gsCages then DrawCages else DrawCells;
  DrawArrows;
  fExists := true;
end;

procedure TCoordGrid.Delete;
begin
  fExists := false;
  CleanOwner;
end;

{ TCrosshair }

procedure TCrosshair.Draw;
begin
  fExists := true;
  fOwner.MoveTo(fCursorPos.x-fOneSize, fCursorPos.y);
  fOwner.LineTo(fCursorPos.x+fOneSize, fCursorPos.y);
  fOwner.MoveTo(fCursorPos.x, fCursorPos.y-fOneSize);
  fOwner.LineTo(fCursorPos.x, fCursorPos.y+fOneSize);
end;

procedure TCrosshair.Delete;
begin
  fExists := false;
  CleanOwner;
end;

{ TGraph }

procedure TGraph.Draw;
var
  Coef, Left, Right: Extended;
  err: terr;
  i: integer;
  Matrix: TFloatMatrix;
  Calc: TCalculator;
begin
  fExists := true;
  fOwner.Pen.Width := fLinesWidth;
  fOwner.Pen.Color := fLinesColor;
  err.Reason := errNone;
  Coef := 1/(fOneSize/2);
  Left := -(fOwner.ClipRect.Right)/2;
  Right := (fOwner.ClipRect.Right)/2;
  Calc := TCalculator.Create(Func);
  Calc.IsRad := IsRad;
  Matrix := Calc.FormGraphMatrix(Left, Right, Coef,
    fOwner.ClipRect.Bottom);
  Calc.Free;
  SetLength(fWorkMatrix, Length(Matrix), 2);
  for i := 0 to High(fWorkMatrix) do
  begin
    fWorkMatrix[i, 0] := Round(Matrix[i, 0] * fOneSize) + fCursorPos.x;
    fWorkMatrix[i, 1] := -Round(Matrix[i, 1] * fOneSize) + fCursorPos.y;
  end;
  i := 0;
  while i <= high(fWorkMatrix)-1 do
  begin
    if abs(fWorkMatrix[i, 1] - fWorkMatrix[i+1, 1]) > fOwner.ClipRect.Bottom then
    begin
      inc(i);
      continue;
    end;
    fOwner.MoveTo(fWorkMatrix[i,0], fWorkMatrix[i,1]);
    fOwner.LineTo(fWorkMatrix[i+1, 0], fWorkMatrix[i+1, 1]);
    inc(i);
  end;
  fOwner.Pen.Color := clBlack;
  fOwner.Pen.Width := 1;
end;

procedure TGraph.Delete;
begin
  fExists := false;
  CleanOwner;
end;

{ TFigure }

procedure TFigure.SetGraphColor(const AValue: TColor);
begin
  fGraphColor := AValue;
end;

procedure TFigure.SetSourcePoints(const AValue: TFunction);
begin
  fSourcePoints := AValue;
end;

constructor TFigure.Create(OwnerComp: PCanvas; const CurPos: UsedTypes.TPoint);
begin
  fOwner := OwnerComp;
  fCursorPos := CurPos;
  Grid := TCoordGrid.Create(OwnerComp, CurPos);
  fExists := False;
  Graphs := TList.Create;
end;

destructor TFigure.Destroy;
var
  i: integer;
begin
  Grid.Free;
  for i := 0 to Graphs.Count - 1 do
    TGraph(Graphs.Items[i]).Free;
  Graphs.Clear;
  Graphs.Free;
  inherited Destroy;
end;

procedure TFigure.Draw;
var
 i: integer;
 Graph: TGraph;
begin
  if (not ManyInOne) or (not Grid.fExists) then
  begin
    CleanOwner;
    Grid.Style := GridStyle;
    Grid.CursorPos := fCursorPos;
    Grid.LinesColor := fLinesColor;
    Grid.LinesWidth := fLinesWidth;
    Grid.OneSize := fOneSize;
    Grid.Draw;
  end;
  if not ManyInOne then
  begin
    for i := 0 to Graphs.Count - 1 do
      TGraph(Graphs.Items[i]).Free;
    Graphs.Clear;
  end;
  Graph := TGraph.Create(fOwner, fCursorPos);
  Graph.Func := Func;
  Graph.IsRad := IsRad;
  Graph.LinesColor := fGraphColor;
  Graph.LinesWidth := fLinesWidth;
  Graph.OneSize := fOneSize;
  Graph.Draw;
  Graphs.Add(Graph);
  fExists := true;
end;

procedure TFigure.TableDraw;
var
 i: integer;
 Graph: TTableGraph;
begin
  if (not ManyInOne) or (not Grid.fExists) then
  begin
    CleanOwner;
    Grid.Style := GridStyle;
    Grid.CursorPos := fCursorPos;
    Grid.LinesColor := fLinesColor;
    Grid.LinesWidth := fLinesWidth;
    Grid.OneSize := fOneSize;
    Grid.Draw;
  end;
  if not ManyInOne then
  begin
    for i := 0 to Graphs.Count - 1 do
      TGraph(Graphs.Items[i]).Free;
    Graphs.Clear;
  end;
  Graph := TTableGraph.Create(fOwner, fCursorPos);
  Graph.LinesColor := fGraphColor;
  Graph.LinesWidth := fLinesWidth;
  Graph.OneSize := fOneSize;
  Graph.fSourcePoints := fSourcePoints;
  Graph.Draw;
  Graphs.Add(Graph);
  fExists := true;
end;

procedure TFigure.Redraw;
var
  i: integer;
begin
  CleanOwner;
  Grid.OneSize := Self.OneSize;
  Grid.LinesColor := Self.LinesColor;
  Grid.Redraw;
  for i := 0 to Graphs.Count - 1 do
  begin
    TGraph(Graphs.Items[i]).LinesColor := Self.GraphColor;
    TGraph(Graphs.Items[i]).OneSize := Self.OneSize;
    TGraph(Graphs.Items[i]).Draw;
  end;
end;

procedure TFigure.Delete;
var
  i: integer;
begin
  Grid.Delete;
  for i := 0 to Graphs.Count - 1 do
    TGraph(Graphs.Items[i]).Free;
  Graphs.Clear;
  fExists := false;
end;

{ TTableGraph }

procedure TTableGraph.SetSourcePoints(const AValue: TFunction);
begin
  fSourcePoints := AValue;
end;

procedure TTableGraph.Draw;
var
  Coef, Left, Right: Extended;
  err: terr;
  i: integer;
  Arguments: TVector;
  interp: TLagrangeInterpolator;
begin
  fExists := true;
  fOwner.Pen.Width := fLinesWidth;
  fOwner.Pen.Color := fLinesColor;
  err.Reason := errNone;
  Coef := 1/(fOneSize/2);
  Left := -(fOwner.ClipRect.Right)/2;
  Right := (fOwner.ClipRect.Right)/2;
  interp := TLagrangeInterpolator.Create(fSourcePoints);
  SetLength(Arguments, round((right - left)/Coef));
  for i := 0 to high(Arguments) do
  begin
    Arguments[i] := Left;
    Left := Left + Coef
  end;
  interp.UnknownPoints := Arguments;
  interp.FindUnknownPoints;
  SetLength(fWorkMatrix, Length(Arguments), 2);
  for i := 0 to High(fWorkMatrix) do
  begin
    fWorkMatrix[i, 0] := Round(Arguments[i] * fOneSize) + fCursorPos.x;
    fWorkMatrix[i, 1] := -Round(interp.InterpResult[i] * fOneSize) + fCursorPos.y;
  end;
  i := 0;
  while i <= high(fWorkMatrix)-1 do
  begin
    if abs(fWorkMatrix[i, 1] - fWorkMatrix[i+1, 1]) > fOwner.ClipRect.Bottom then
    begin
      inc(i);
      continue;
    end;
    fOwner.MoveTo(fWorkMatrix[i,0], fWorkMatrix[i,1]);
    fOwner.LineTo(fWorkMatrix[i+1, 0], fWorkMatrix[i+1, 1]);
    inc(i);
  end;
  fOwner.Pen.Color := clBlack;
  fOwner.Pen.Width := 1;
  interp.Free;
end;

end.

